home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / ProjectOberon / Viewers.Mod < prev   
Text File  |  1995-04-15  |  8KB  |  253 lines
  1. MODULE Viewers; (*JG 14.9.90*)
  2.  
  3.     IMPORT Display;
  4.  
  5.     CONST
  6.     restore* = 0; modify* = 1; suspend* = 2; (*message ids*)
  7.       inf = MAX(INTEGER);
  8.  
  9.     TYPE
  10.      Viewer* = POINTER TO ViewerDesc;
  11.  
  12.      ViewerDesc* = RECORD
  13.        (Display.FrameDesc)
  14.          state*: INTEGER
  15.      END;
  16.  
  17.      (*state > 1: displayed
  18.         state = 1: filler
  19.         state = 0: closed
  20.         state < 0: suspended*)
  21.  
  22.      ViewerMsg* = RECORD
  23.         (Display.FrameMsg)
  24.        id*: INTEGER;
  25.        X*, Y*, W*, H*: INTEGER;
  26.        state*: INTEGER
  27.      END;
  28.  
  29.      Track = POINTER TO TrackDesc;
  30.  
  31.      TrackDesc = RECORD
  32.        (ViewerDesc)
  33.        under: Display.Frame
  34.      END;
  35.  
  36.     VAR
  37.       curW*, minH*, DW, DH: INTEGER;
  38.       FillerTrack: Track; FillerViewer, buf: Viewer; (*for closed viewers*)
  39.  
  40.     PROCEDURE Open* (V: Viewer; X, Y: INTEGER);
  41.       VAR T, u, v: Display.Frame; M: ViewerMsg;
  42.     BEGIN
  43.       IF (V.state = 0) & (X < inf) THEN
  44.           IF Y > DH THEN Y := DH END;
  45.       T := FillerTrack.next;
  46.       WHILE X >= T.X + T.W DO T := T.next END;
  47.       u := T.dsc; v := u.next;
  48.       WHILE Y > v.Y + v.H DO u := v; v := u.next END;
  49.           IF Y < v.Y + minH THEN Y := v.Y + minH END;
  50.       IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
  51.             WITH v: Viewer DO
  52.           V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H;
  53.         M.id := suspend; M.state := 0;
  54.               v.handle(v, M); v.state := 0; buf := v;
  55.           V.next := v.next; u.next := V;
  56.           V.state := 2
  57.             END
  58.       ELSE
  59.         V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y;
  60.         M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
  61.             v.handle(v, M); v.Y := M.Y; v.H := M.H;
  62.       V.next := v; u.next := V;
  63.         V.state := 2
  64.       END
  65.       END
  66.     END Open;
  67.   
  68.     PROCEDURE Change* (V: Viewer; Y: INTEGER);
  69.       VAR v: Display.Frame; M: ViewerMsg;
  70.     BEGIN
  71.       IF V.state > 1 THEN
  72.        IF Y > DH THEN Y := DH END;
  73.        v := V.next;
  74.        IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
  75.         Y := v.Y + v.H - minH
  76.       END;
  77.       IF Y >= V.Y + minH THEN
  78.         M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
  79.               v.handle(v, M); v.Y := M.Y; v.H := M.H;
  80.         V.H := Y - V.Y
  81.       END
  82.      END
  83.     END Change;
  84.  
  85.     PROCEDURE RestoreTrack (S: Display.Frame);
  86.       VAR T, t, v: Display.Frame; M: ViewerMsg;
  87.   BEGIN
  88.     WITH S: Track DO
  89.        t := S.next;
  90.         WHILE t.next.X # S.X DO t := t.next END;
  91.         T := S.under;
  92.         WHILE T.next # NIL DO T := T.next END;
  93.         t.next := S.under; T.next := S.next;
  94.         M.id := restore;
  95.         REPEAT t := t.next;
  96.           v := t.dsc;
  97.           REPEAT v := v.next; v.handle(v, M);
  98.             WITH v: Viewer DO v.state := - v.state END
  99.           UNTIL v = t.dsc
  100.         UNTIL t = T
  101.      END
  102.      END RestoreTrack;
  103.  
  104.     PROCEDURE Close* (V: Viewer);
  105.       VAR T, U: Display.Frame; M: ViewerMsg;
  106.     BEGIN
  107.         IF V.state > 1 THEN
  108.             U := V.next; T := FillerTrack;
  109.         REPEAT T := T.next UNTIL V.X < T.X + T.W;
  110.             IF (T(Track).under = NIL) OR (U.next # V) THEN
  111.             M.id := suspend; M.state := 0;
  112.                 V.handle(V, M); V.state := 0; buf := V;
  113.                 M.id := modify; M.Y := V.Y; M.H := V.H + U.H;
  114.             U.handle(U, M); U.Y := M.Y; U.H := M.H;
  115.           WHILE U.next # V DO U := U.next END;
  116.               U.next := V.next
  117.             ELSE (*close track*)
  118.               M.id := suspend; M.state := 0;
  119.                 V.handle(V, M); V.state := 0; buf := V;
  120.             U.handle(U, M); U(Viewer).state := 0;
  121.           RestoreTrack(T)
  122.             END
  123.         END
  124.      END Close;
  125.  
  126.     PROCEDURE Recall* ( VAR V: Viewer);
  127.     BEGIN V := buf
  128.     END Recall;
  129.  
  130.     PROCEDURE This* (X, Y: INTEGER): Viewer;
  131.       VAR T, V: Display.Frame;
  132.     BEGIN
  133.       IF (X < inf) & (Y < DH) THEN
  134.         T := FillerTrack;
  135.         REPEAT T := T.next UNTIL X < T.X + T.W;
  136.         V := T.dsc;
  137.         REPEAT V := V.next UNTIL Y < V.Y + V.H;
  138.         RETURN V(Viewer)
  139.       ELSE RETURN NIL
  140.       END
  141.     END This;
  142.  
  143.     PROCEDURE Next* (V: Viewer): Viewer;
  144.     BEGIN RETURN V.next(Viewer)
  145.     END Next;
  146.  
  147.     PROCEDURE Locate* (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
  148.       VAR T, V: Display.Frame;
  149.     BEGIN
  150.       IF X < inf THEN
  151.         T := FillerTrack;
  152.         REPEAT T := T.next UNTIL X < T.X + T.W;
  153.         fil := T.dsc; bot := fil.next;
  154.         IF bot.next # fil THEN
  155.           alt := bot.next; V := alt.next;
  156.           WHILE (V # fil) & (alt.H < H) DO
  157.             IF V.H > alt.H THEN alt := V END; V := V.next
  158.           END
  159.         ELSE alt := bot
  160.         END;
  161.         max := T.dsc; V := max.next;
  162.       WHILE V # fil DO
  163.           IF V.H > max.H THEN max := V END; V := V.next
  164.         END
  165.       END
  166.     END Locate;
  167.  
  168.     PROCEDURE InitTrack* (W, H: INTEGER; Filler: Viewer);
  169.       VAR S: Display.Frame; T: Track;
  170.   BEGIN
  171.         IF Filler.state = 0 THEN
  172.           Filler.X := curW; Filler.W := W; Filler.Y := 0; Filler.H := H;
  173.           Filler.state := 1;
  174.           Filler.next := Filler;
  175.         NEW(T);
  176.         T.X := curW; T.W := W; T.Y := 0; T.H := H;
  177.         T.dsc := Filler; T.under := NIL;
  178.           FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X;
  179.         FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W;
  180.           S := FillerTrack;
  181.             WHILE S.next # FillerTrack DO S := S.next END;
  182.         S.next := T; T.next := FillerTrack;
  183.             curW := curW + W
  184.         END
  185.     END InitTrack;
  186.  
  187.     PROCEDURE OpenTrack* (X, W: INTEGER; Filler: Viewer);
  188.       VAR newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg;
  189.     BEGIN
  190.       IF (X < inf) & (Filler.state = 0) THEN
  191.         S := FillerTrack; T := S.next;
  192.         WHILE X >= T.X + T.W DO S := T; T := S.next END;
  193.         WHILE X + W > T.X + T.W DO T := T.next END;
  194.         M.id := suspend;
  195.         t := S;
  196.         REPEAT t := t.next; v := t.dsc;
  197.           REPEAT v := v.next;
  198.                     WITH v: Viewer DO
  199.                       M.state := -v.state; v.handle(v, M); v.state := M.state
  200.                     END
  201.         UNTIL v = t.dsc
  202.       UNTIL t = T;
  203.         Filler.X := S.next.X; Filler.W := T.X + T.W - S.next.X; Filler.Y :=
  204. 0; Filler.H := DH;
  205.       Filler.state := 1;
  206.       Filler.next := Filler;
  207.       NEW(newT);
  208.        newT.X := Filler.X; newT.W := Filler.W; newT.Y := 0; newT.H := DH;
  209.         newT.dsc := Filler; newT.under := S.next; S.next := newT;
  210.         newT.next := T.next; T.next := NIL
  211.       END
  212.     END OpenTrack;
  213.  
  214.     PROCEDURE CloseTrack* (X: INTEGER);
  215.       VAR T, V: Display.Frame; M: ViewerMsg;
  216.     BEGIN
  217.       IF X < inf THEN
  218.         T := FillerTrack;
  219.         REPEAT T := T.next UNTIL X < T.X + T.W;
  220.         IF T(Track).under # NIL THEN
  221.           M.id := suspend; M.state := 0; V := T.dsc;
  222.           REPEAT V := V.next; V.handle(V, M); V(Viewer).state := 0 UNTIL V =
  223. T.dsc;
  224.           RestoreTrack(T)
  225.         END
  226.       END
  227.     END CloseTrack;
  228.  
  229.   PROCEDURE Broadcast* (VAR M: Display.FrameMsg);
  230.       VAR T, V: Display.Frame;
  231.   BEGIN
  232.       T := FillerTrack.next;
  233.       WHILE T # FillerTrack DO
  234.         V := T.dsc; 
  235.         REPEAT V := V.next; V.handle(V, M) UNTIL V = T.dsc;
  236.         T := T.next
  237.       END
  238.   END Broadcast;
  239.  
  240. BEGIN buf := NIL;
  241.     NEW(FillerViewer);
  242.     FillerViewer.X := 0; FillerViewer.W := inf; FillerViewer.Y := 0; FillerViewer.H
  243. := DH;
  244.     FillerViewer.next := FillerViewer;
  245.     NEW(FillerTrack);
  246.     FillerTrack.X := 0; FillerTrack.W := inf; FillerTrack.Y := 0; FillerTrack.H
  247. := DH;
  248.     FillerTrack.dsc := FillerViewer;
  249.     FillerTrack.next := FillerTrack;
  250.     curW := 0; minH := 1;
  251.     DW := Display.Width; DH := Display.Height
  252. END Viewers.
  253.